home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / a_14_Handy2056213262007.psc / Handy Modules / modEncryption.bas < prev    next >
BASIC Source File  |  2007-03-26  |  33KB  |  872 lines
  1. Attribute VB_Name = "modEncryption"
  2. Option Explicit
  3. Option Base 0
  4.  
  5. Private m_lOnBits(30)           As Long
  6. Private m_l2Power(30)           As Long
  7. Private lngTrack                As Long
  8. Private arrLongConversion(4)    As Long
  9. Private arrSplit64(63)          As Byte
  10. Private aDecTab(255)            As Integer
  11. Private s(0 To 255)             As Integer
  12. Private kep(0 To 255)           As Integer
  13. Private i As Integer, j         As Integer
  14. Private path                    As String
  15.  
  16. Private Const OFFSET_4 = 4294967296#
  17. Private Const MAXINT_4 = 2147483647
  18. Private Const BITS_TO_A_BYTE  As Long = 8
  19. Private Const BYTES_TO_A_WORD As Long = 4
  20. Private Const BITS_TO_A_WORD  As Long = BYTES_TO_A_WORD * BITS_TO_A_BYTE
  21. Private Const S11 = 7
  22. Private Const S12 = 12
  23. Private Const S13 = 17
  24. Private Const S14 = 22
  25. Private Const S21 = 5
  26. Private Const S22 = 9
  27. Private Const S23 = 14
  28. Private Const S24 = 20
  29. Private Const S31 = 4
  30. Private Const S32 = 11
  31. Private Const S33 = 16
  32. Private Const S34 = 23
  33. Private Const S41 = 6
  34. Private Const S42 = 10
  35. Private Const S43 = 15
  36. Private Const S44 = 21
  37. Private Const sEncTab As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  38.  
  39. Private Function LShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
  40.     If iShiftBits = 0 Then
  41.         LShift = lValue
  42.         Exit Function
  43.     ElseIf iShiftBits = 31 Then
  44.         If lValue And 1 Then
  45.             LShift = &H80000000
  46.         Else
  47.             LShift = 0
  48.         End If
  49.         Exit Function
  50.     ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
  51.         Err.Raise 6
  52.     End If
  53.     If (lValue And m_l2Power(31 - iShiftBits)) Then
  54.         LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
  55.     
  56.     Else
  57.         LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
  58.     End If
  59. End Function
  60.  
  61. Private Function RShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
  62.     If iShiftBits = 0 Then
  63.         RShift = lValue
  64.         Exit Function
  65.     ElseIf iShiftBits = 31 Then
  66.         If lValue And &H80000000 Then
  67.             RShift = 1
  68.         Else
  69.             RShift = 0
  70.         End If
  71.         Exit Function
  72.     ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
  73.         Err.Raise 6
  74.     End If
  75.     RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
  76.     If (lValue And &H80000000) Then
  77.         RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
  78.     End If
  79. End Function
  80.  
  81. Private Function AddUnsigned(ByVal lX As Long, ByVal lY As Long) As Long
  82.     Dim lX4     As Long
  83.     Dim lY4     As Long
  84.     Dim lX8     As Long
  85.     Dim lY8     As Long
  86.     Dim lResult As Long
  87.     lX8 = lX And &H80000000
  88.     lY8 = lY And &H80000000
  89.     lX4 = lX And &H40000000
  90.     lY4 = lY And &H40000000
  91.     lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
  92.     If lX4 And lY4 Then
  93.         lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
  94.     ElseIf lX4 Or lY4 Then
  95.         If lResult And &H40000000 Then
  96.             lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
  97.         Else
  98.             lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
  99.         End If
  100.     Else
  101.         lResult = lResult Xor lX8 Xor lY8
  102.     End If
  103.     AddUnsigned = lResult
  104. End Function
  105.  
  106. Private Function LRot(ByVal x As Long, ByVal n As Long) As Long
  107.     LRot = LShift(x, n) Or RShift(x, (32 - n))
  108. End Function
  109.  
  110. Private Function ConvertToWordArray(sMessage As String) As Long()
  111.     Dim lMessageLength  As Long
  112.     Dim lNumberOfWords  As Long
  113.     Dim lWordArray()    As Long
  114.     Dim lBytePosition   As Long
  115.     Dim lByteCount      As Long
  116.     Dim lWordCount      As Long
  117.     Dim lByte           As Long
  118.     Const MODULUS_BITS      As Long = 512
  119.     Const CONGRUENT_BITS    As Long = 448
  120.     lMessageLength = Len(sMessage)
  121.     lNumberOfWords = (((lMessageLength + _
  122.         ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ _
  123.         (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * _
  124.         (MODULUS_BITS \ BITS_TO_A_WORD)
  125.     ReDim lWordArray(lNumberOfWords - 1)
  126.     lBytePosition = 0
  127.     lByteCount = 0
  128.     Do Until lByteCount >= lMessageLength
  129.         lWordCount = lByteCount \ BYTES_TO_A_WORD
  130.         lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
  131.         lByte = AscB(Mid(sMessage, lByteCount + 1, 1))
  132.         
  133.         lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)
  134.         lByteCount = lByteCount + 1
  135.     Loop
  136.     lWordCount = lByteCount \ BYTES_TO_A_WORD
  137.     lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
  138.     lWordArray(lWordCount) = lWordArray(lWordCount) Or _
  139.     LShift(&H80, lBytePosition)
  140.     lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)
  141.     lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)
  142.     ConvertToWordArray = lWordArray
  143. End Function
  144.  
  145. Private Function EncodeQuantum(B() As Byte) As String
  146.     Dim sOutput As String
  147.     Dim c As Integer
  148.     
  149.     sOutput = ""
  150.     c = SHR2(B(0)) And &H3F
  151.     sOutput = sOutput & Mid(sEncTab, c + 1, 1)
  152.     c = SHL4(B(0) And &H3) Or (SHR4(B(1)) And &HF)
  153.     sOutput = sOutput & Mid(sEncTab, c + 1, 1)
  154.     c = SHL2(B(1) And &HF) Or (SHR6(B(2)) And &H3)
  155.     sOutput = sOutput & Mid(sEncTab, c + 1, 1)
  156.     c = B(2) And &H3F
  157.     sOutput = sOutput & Mid(sEncTab, c + 1, 1)
  158.     
  159.     EncodeQuantum = sOutput
  160.     
  161. End Function
  162.  
  163. Private Function DecodeQuantum(d() As Byte) As String
  164.     Dim sOutput As String
  165.     Dim c As Long
  166.     
  167.     sOutput = ""
  168.     c = SHL2(d(0)) Or (SHR4(d(1)) And &H3)
  169.     sOutput = sOutput & Chr$(c)
  170.     c = SHL4(d(1) And &HF) Or (SHR2(d(2)) And &HF)
  171.     sOutput = sOutput & Chr$(c)
  172.     c = SHL6(d(2) And &H3) Or d(3)
  173.     sOutput = sOutput & Chr$(c)
  174.     
  175.     DecodeQuantum = sOutput
  176.     
  177. End Function
  178.  
  179. Private Function MakeDecTab()
  180. ' Set up Radix 64 decoding table
  181.     Dim t As Integer
  182.     Dim c As Integer
  183.  
  184.     For c = 0 To 255
  185.         aDecTab(c) = -1
  186.     Next
  187.   
  188.     t = 0
  189.     For c = Asc("A") To Asc("Z")
  190.         aDecTab(c) = t
  191.         t = t + 1
  192.     Next
  193.   
  194.     For c = Asc("a") To Asc("z")
  195.         aDecTab(c) = t
  196.         t = t + 1
  197.     Next
  198.     
  199.     For c = Asc("0") To Asc("9")
  200.         aDecTab(c) = t
  201.         t = t + 1
  202.     Next
  203.     
  204.     c = Asc("+")
  205.     aDecTab(c) = t
  206.     t = t + 1
  207.     
  208.     c = Asc("/")
  209.     aDecTab(c) = t
  210.     t = t + 1
  211.     
  212.     c = Asc("=")    ' flag for the byte-deleting char
  213.     aDecTab(c) = t  ' should be 64
  214.  
  215. End Function
  216.  
  217. ' Version 3: ShiftLeft and ShiftRight functions improved.
  218. Private Function SHL2(ByVal bytValue As Byte) As Byte
  219. ' Shift 8-bit value to left by 2 bits
  220. ' i.e. VB equivalent of "bytValue << 2" in C
  221.     SHL2 = (bytValue * &H4) And &HFF
  222. End Function
  223.  
  224. Private Function SHL4(ByVal bytValue As Byte) As Byte
  225. ' Shift 8-bit value to left by 4 bits
  226. ' i.e. VB equivalent of "bytValue << 4" in C
  227.     SHL4 = (bytValue * &H10) And &HFF
  228. End Function
  229.  
  230. Private Function SHL6(ByVal bytValue As Byte) As Byte
  231. ' Shift 8-bit value to left by 6 bits
  232. ' i.e. VB equivalent of "bytValue << 6" in C
  233.     SHL6 = (bytValue * &H40) And &HFF
  234. End Function
  235.  
  236. Private Function SHR2(ByVal bytValue As Byte) As Byte
  237. ' Shift 8-bit value to right by 2 bits
  238. ' i.e. VB equivalent of "bytValue >> 2" in C
  239.     SHR2 = bytValue \ &H4
  240. End Function
  241.  
  242. Private Function SHR4(ByVal bytValue As Byte) As Byte
  243. ' Shift 8-bit value to right by 4 bits
  244. ' i.e. VB equivalent of "bytValue >> 4" in C
  245.     SHR4 = bytValue \ &H10
  246. End Function
  247.  
  248. Private Function SHR6(ByVal bytValue As Byte) As Byte
  249. ' Shift 8-bit value to right by 6 bits
  250. ' i.e. VB equivalent of "bytValue >> 6" in C
  251.     SHR6 = bytValue \ &H40
  252. End Function
  253.  
  254.  
  255.  
  256. Private Function MD5Round(strRound As String, A As Long, B As Long, c As Long, d As Long, x As Long, s As Long, ac As Long) As Long
  257.     Select Case strRound
  258.         Case Is = "FF"
  259.             A = MD5LongAdd4(A, (B And c) Or (Not (B) And d), x, ac)
  260.             A = MD5Rotate(A, s)
  261.             A = MD5LongAdd(A, B)
  262.         Case Is = "GG"
  263.             A = MD5LongAdd4(A, (B And d) Or (c And Not (d)), x, ac)
  264.             A = MD5Rotate(A, s)
  265.             A = MD5LongAdd(A, B)
  266.         Case Is = "HH"
  267.             A = MD5LongAdd4(A, B Xor c Xor d, x, ac)
  268.             A = MD5Rotate(A, s)
  269.             A = MD5LongAdd(A, B)
  270.         Case Is = "II"
  271.             A = MD5LongAdd4(A, c Xor (B Or Not (d)), x, ac)
  272.             A = MD5Rotate(A, s)
  273.             A = MD5LongAdd(A, B)
  274.     End Select
  275. End Function
  276.  
  277. Private Function MD5Rotate(lngValue As Long, lngBits As Long) As Long
  278. Dim lngSign As Long
  279. Dim lngI As Long
  280.     lngBits = (lngBits Mod 32)
  281.     
  282.     If lngBits = 0 Then MD5Rotate = lngValue: Exit Function
  283.     
  284.     For lngI = 1 To lngBits
  285.         lngSign = lngValue And &HC0000000
  286.         lngValue = (lngValue And &H3FFFFFFF) * 2
  287.         lngValue = lngValue Or ((lngSign < 0) And 1) Or (CBool(lngSign And &H40000000) And &H80000000)
  288.     Next
  289.     
  290.     MD5Rotate = lngValue
  291. End Function
  292.  
  293. Private Function TRID() As String
  294.  
  295.     Dim sngNum As Single, lngnum As Long
  296.     Dim strResult As String
  297.    
  298.     sngNum = Rnd(2147483648#)
  299.     strResult = CStr(sngNum)
  300.     
  301.     strResult = Replace(strResult, "0.", "")
  302.     strResult = Replace(strResult, ".", "")
  303.     strResult = Replace(strResult, "E-", "")
  304.     
  305.     TRID = strResult
  306.  
  307. End Function
  308.  
  309. Private Function MD564Split(lngLength As Long, bytBuffer() As Byte) As String
  310.  
  311.     Dim lngBytesTotal As Long, lngBytesToAdd As Long
  312.     Dim intLoop As Integer, intLoop2 As Integer, lngTrace As Long
  313.     Dim intInnerLoop As Integer, intLoop3 As Integer
  314.     
  315.     lngBytesTotal = lngTrack Mod 64
  316.     lngBytesToAdd = 64 - lngBytesTotal
  317.     lngTrack = (lngTrack + lngLength)
  318.     
  319.     If lngLength >= lngBytesToAdd Then
  320.         For intLoop = 0 To lngBytesToAdd - 1
  321.             arrSplit64(lngBytesTotal + intLoop) = bytBuffer(intLoop)
  322.         Next intLoop
  323.         
  324.         MD5Conversion arrSplit64
  325.         
  326.         lngTrace = (lngLength) Mod 64
  327.  
  328.         For intLoop2 = lngBytesToAdd To lngLength - intLoop - lngTrace Step 64
  329.             For intInnerLoop = 0 To 63
  330.                 arrSplit64(intInnerLoop) = bytBuffer(intLoop2 + intInnerLoop)
  331.             Next intInnerLoop
  332.             
  333.             MD5Conversion arrSplit64
  334.         
  335.         Next intLoop2
  336.         
  337.         lngBytesTotal = 0
  338.     Else
  339.     
  340.       intLoop2 = 0
  341.     
  342.     End If
  343.     
  344.     For intLoop3 = 0 To lngLength - intLoop2 - 1
  345.         
  346.         arrSplit64(lngBytesTotal + intLoop3) = bytBuffer(intLoop2 + intLoop3)
  347.     
  348.     Next intLoop3
  349.      
  350. End Function
  351.  
  352. Private Function MD5StringArray(strInput As String) As Byte()
  353.     
  354.     Dim intLoop As Integer
  355.     Dim bytBuffer() As Byte
  356.     ReDim bytBuffer(Len(strInput))
  357.     
  358.     For intLoop = 0 To Len(strInput) - 1
  359.         bytBuffer(intLoop) = Asc(Mid(strInput, intLoop + 1, 1))
  360.     Next intLoop
  361.     
  362.     MD5StringArray = bytBuffer
  363.     
  364. End Function
  365.  
  366. Private Sub MD5Conversion(bytBuffer() As Byte)
  367.  
  368.     Dim x(16) As Long, A As Long
  369.     Dim B As Long, c As Long
  370.     Dim d As Long
  371.     
  372.     A = arrLongConversion(1)
  373.     B = arrLongConversion(2)
  374.     c = arrLongConversion(3)
  375.     d = arrLongConversion(4)
  376.     
  377.     MD5Decode 64, x, bytBuffer
  378.     
  379.     MD5Round "FF", A, B, c, d, x(0), S11, -680876936
  380.     MD5Round "FF", d, A, B, c, x(1), S12, -389564586
  381.     MD5Round "FF", c, d, A, B, x(2), S13, 606105819
  382.     MD5Round "FF", B, c, d, A, x(3), S14, -1044525330
  383.     MD5Round "FF", A, B, c, d, x(4), S11, -176418897
  384.     MD5Round "FF", d, A, B, c, x(5), S12, 1200080426
  385.     MD5Round "FF", c, d, A, B, x(6), S13, -1473231341
  386.     MD5Round "FF", B, c, d, A, x(7), S14, -45705983
  387.     MD5Round "FF", A, B, c, d, x(8), S11, 1770035416
  388.     MD5Round "FF", d, A, B, c, x(9), S12, -1958414417
  389.     MD5Round "FF", c, d, A, B, x(10), S13, -42063
  390.     MD5Round "FF", B, c, d, A, x(11), S14, -1990404162
  391.     MD5Round "FF", A, B, c, d, x(12), S11, 1804603682
  392.     MD5Round "FF", d, A, B, c, x(13), S12, -40341101
  393.     MD5Round "FF", c, d, A, B, x(14), S13, -1502002290
  394.     MD5Round "FF", B, c, d, A, x(15), S14, 1236535329
  395.  
  396.     MD5Round "GG", A, B, c, d, x(1), S21, -165796510
  397.     MD5Round "GG", d, A, B, c, x(6), S22, -1069501632
  398.     MD5Round "GG", c, d, A, B, x(11), S23, 643717713
  399.     MD5Round "GG", B, c, d, A, x(0), S24, -373897302
  400.     MD5Round "GG", A, B, c, d, x(5), S21, -701558691
  401.     MD5Round "GG", d, A, B, c, x(10), S22, 38016083
  402.     MD5Round "GG", c, d, A, B, x(15), S23, -660478335
  403.     MD5Round "GG", B, c, d, A, x(4), S24, -405537848
  404.     MD5Round "GG", A, B, c, d, x(9), S21, 568446438
  405.     MD5Round "GG", d, A, B, c, x(14), S22, -1019803690
  406.     MD5Round "GG", c, d, A, B, x(3), S23, -187363961
  407.     MD5Round "GG", B, c, d, A, x(8), S24, 1163531501
  408.     MD5Round "GG", A, B, c, d, x(13), S21, -1444681467
  409.     MD5Round "GG", d, A, B, c, x(2), S22, -51403784
  410.     MD5Round "GG", c, d, A, B, x(7), S23, 1735328473
  411.     MD5Round "GG", B, c, d, A, x(12), S24, -1926607734
  412.   
  413.     MD5Round "HH", A, B, c, d, x(5), S31, -378558
  414.     MD5Round "HH", d, A, B, c, x(8), S32, -2022574463
  415.     MD5Round "HH", c, d, A, B, x(11), S33, 1839030562
  416.     MD5Round "HH", B, c, d, A, x(14), S34, -35309556
  417.     MD5Round "HH", A, B, c, d, x(1), S31, -1530992060
  418.     MD5Round "HH", d, A, B, c, x(4), S32, 1272893353
  419.     MD5Round "HH", c, d, A, B, x(7), S33, -155497632
  420.     MD5Round "HH", B, c, d, A, x(10), S34, -1094730640
  421.     MD5Round "HH", A, B, c, d, x(13), S31, 681279174
  422.     MD5Round "HH", d, A, B, c, x(0), S32, -358537222
  423.     MD5Round "HH", c, d, A, B, x(3), S33, -722521979
  424.     MD5Round "HH", B, c, d, A, x(6), S34, 76029189
  425.     MD5Round "HH", A, B, c, d, x(9), S31, -640364487
  426.     MD5Round "HH", d, A, B, c, x(12), S32, -421815835
  427.     MD5Round "HH", c, d, A, B, x(15), S33, 530742520
  428.     MD5Round "HH", B, c, d, A, x(2), S34, -995338651
  429.  
  430.     MD5Round "II", A, B, c, d, x(0), S41, -198630844
  431.     MD5Round "II", d, A, B, c, x(7), S42, 1126891415
  432.     MD5Round "II", c, d, A, B, x(14), S43, -1416354905
  433.     MD5Round "II", B, c, d, A, x(5), S44, -57434055
  434.     MD5Round "II", A, B, c, d, x(12), S41, 1700485571
  435.     MD5Round "II", d, A, B, c, x(3), S42, -1894986606
  436.     MD5Round "II", c, d, A, B, x(10), S43, -1051523
  437.     MD5Round "II", B, c, d, A, x(1), S44, -2054922799
  438.     MD5Round "II", A, B, c, d, x(8), S41, 1873313359
  439.     MD5Round "II", d, A, B, c, x(15), S42, -30611744
  440.     MD5Round "II", c, d, A, B, x(6), S43, -1560198380
  441.     MD5Round "II", B, c, d, A, x(13), S44, 1309151649
  442.     MD5Round "II", A, B, c, d, x(4), S41, -145523070
  443.     MD5Round "II", d, A, B, c, x(11), S42, -1120210379
  444.     MD5Round "II", c, d, A, B, x(2), S43, 718787259
  445.     MD5Round "II", B, c, d, A, x(9), S44, -343485551
  446.     
  447.     arrLongConversion(1) = MD5LongAdd(arrLongConversion(1), A)
  448.     arrLongConversion(2) = MD5LongAdd(arrLongConversion(2), B)
  449.     arrLongConversion(3) = MD5LongAdd(arrLongConversion(3), c)
  450.     arrLongConversion(4) = MD5LongAdd(arrLongConversion(4), d)
  451.     
  452. End Sub
  453.  
  454. Private Function MD5LongAdd(lngVal1 As Long, lngVal2 As Long) As Long
  455.     
  456.     Dim lngHighWord As Long
  457.     Dim lngLowWord As Long
  458.     Dim lngOverflow As Long
  459.  
  460.     lngLowWord = (lngVal1 And &HFFFF&) + (lngVal2 And &HFFFF&)
  461.     lngOverflow = lngLowWord \ 65536
  462.     lngHighWord = (((lngVal1 And &HFFFF0000) \ 65536) + ((lngVal2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
  463.     
  464.     MD5LongAdd = MD5LongConversion((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
  465.  
  466. End Function
  467.  
  468. Private Function MD5LongAdd4(lngVal1 As Long, lngVal2 As Long, lngVal3 As Long, lngVal4 As Long) As Long
  469.     
  470.     Dim lngHighWord As Long
  471.     Dim lngLowWord As Long
  472.     Dim lngOverflow As Long
  473.  
  474.     lngLowWord = (lngVal1 And &HFFFF&) + (lngVal2 And &HFFFF&) + (lngVal3 And &HFFFF&) + (lngVal4 And &HFFFF&)
  475.     lngOverflow = lngLowWord \ 65536
  476.     lngHighWord = (((lngVal1 And &HFFFF0000) \ 65536) + ((lngVal2 And &HFFFF0000) \ 65536) + ((lngVal3 And &HFFFF0000) \ 65536) + ((lngVal4 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
  477.     MD5LongAdd4 = MD5LongConversion((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
  478.  
  479. End Function
  480.  
  481. Private Sub MD5Decode(intLength As Integer, lngOutBuffer() As Long, bytInBuffer() As Byte)
  482.     
  483.     Dim intDblIndex As Integer
  484.     Dim intByteIndex As Integer
  485.     Dim dblSum As Double
  486.     
  487.     intDblIndex = 0
  488.     
  489.     For intByteIndex = 0 To intLength - 1 Step 4
  490.         
  491.         dblSum = bytInBuffer(intByteIndex) + bytInBuffer(intByteIndex + 1) * 256# + bytInBuffer(intByteIndex + 2) * 65536# + bytInBuffer(intByteIndex + 3) * 16777216#
  492.         lngOutBuffer(intDblIndex) = MD5LongConversion(dblSum)
  493.         intDblIndex = (intDblIndex + 1)
  494.     
  495.     Next intByteIndex
  496.  
  497. End Sub
  498.  
  499. Private Function MD5LongConversion(dblValue As Double) As Long
  500.     
  501.     If dblValue < 0 Or dblValue >= OFFSET_4 Then Error 6
  502.         
  503.     If dblValue <= MAXINT_4 Then
  504.         MD5LongConversion = dblValue
  505.     Else
  506.         MD5LongConversion = dblValue - OFFSET_4
  507.     End If
  508.         
  509. End Function
  510.  
  511. Private Sub MD5Finish()
  512. Dim dblBits As Double
  513. Dim arrPadding(72) As Byte
  514. Dim lngBytesBuffered As Long
  515.     
  516.     arrPadding(0) = &H80
  517.     dblBits = lngTrack * 8
  518.     
  519.     lngBytesBuffered = lngTrack Mod 64
  520.     
  521.     If lngBytesBuffered <= 56 Then
  522.         MD564Split (56 - lngBytesBuffered), arrPadding
  523.     Else
  524.         MD564Split (120 - lngTrack), arrPadding
  525.     End If
  526.     
  527.     
  528.     arrPadding(0) = MD5LongConversion(dblBits) And &HFF&
  529.     arrPadding(1) = MD5LongConversion(dblBits) \ 256 And &HFF&
  530.     arrPadding(2) = MD5LongConversion(dblBits) \ 65536 And &HFF&
  531.     arrPadding(3) = MD5LongConversion(dblBits) \ 16777216 And &HFF&
  532.     arrPadding(4) = 0
  533.     arrPadding(5) = 0
  534.     arrPadding(6) = 0
  535.     arrPadding(7) = 0
  536.     
  537.     MD564Split 8, arrPadding
  538. End Sub
  539.  
  540. Private Function MD5StringChange(lngnum As Long) As String
  541. Dim bytA As Byte
  542. Dim bytB As Byte
  543. Dim bytC As Byte
  544. Dim bytD As Byte
  545.      bytA = lngnum And &HFF&
  546.      If bytA < 16 Then
  547.          MD5StringChange = "0" & Hex(bytA)
  548.      Else
  549.          MD5StringChange = Hex(bytA)
  550.      End If
  551.             
  552.      bytB = (lngnum And &HFF00&) \ 256
  553.      If bytB < 16 Then
  554.          MD5StringChange = MD5StringChange & "0" & Hex(bytB)
  555.      Else
  556.          MD5StringChange = MD5StringChange & Hex(bytB)
  557.      End If
  558.      
  559.      bytC = (lngnum And &HFF0000) \ 65536
  560.      If bytC < 16 Then
  561.          MD5StringChange = MD5StringChange & "0" & Hex(bytC)
  562.      Else
  563.          MD5StringChange = MD5StringChange & Hex(bytC)
  564.      End If
  565.     
  566.      If lngnum < 0 Then
  567.          bytD = ((lngnum And &H7F000000) \ 16777216) Or &H80&
  568.      Else
  569.          bytD = (lngnum And &HFF000000) \ 16777216
  570.      End If
  571.      
  572.      If bytD < 16 Then
  573.          MD5StringChange = MD5StringChange & "0" & Hex(bytD)
  574.      Else
  575.          MD5StringChange = MD5StringChange & Hex(bytD)
  576.      End If
  577. End Function
  578.  
  579. Private Function MD5Value() As String
  580.     MD5Value = LCase(MD5StringChange(arrLongConversion(1)) & MD5StringChange(arrLongConversion(2)) & MD5StringChange(arrLongConversion(3)) & MD5StringChange(arrLongConversion(4)))
  581. End Function
  582.  
  583. Private Sub MD5Start()
  584.     lngTrack = 0
  585.     arrLongConversion(1) = MD5LongConversion(1732584193#)
  586.     arrLongConversion(2) = MD5LongConversion(4023233417#)
  587.     arrLongConversion(3) = MD5LongConversion(2562383102#)
  588.     arrLongConversion(4) = MD5LongConversion(271733878#)
  589. End Sub
  590. '#############################################################################
  591. '#############################################################################
  592. '#############################################################################
  593. '#############################################################################
  594. '#############################################################################
  595. '#############################################################################
  596. '#############################################################################
  597. '#############################################################################
  598. '#############################################################################
  599. '#############################################################################
  600. '#############################################################################
  601. '#############################################################################
  602. '#############################################################################
  603. '#############################################################################
  604. '#############################################################################
  605. '#############################################################################
  606. '#############################################################################
  607. '#############################################################################
  608. '#############################################################################
  609. '#############################################################################
  610. '#############################################################################
  611. '#############################################################################
  612. '#############################################################################
  613. '#############################################################################
  614. '#############################################################################
  615. '#############################################################################
  616. '#############################################################################
  617. '#############################################################################
  618. '#############################################################################
  619. '#############################################################################
  620. '#############################################################################
  621. '#############################################################################
  622. '#############################################################################
  623. '#############################################################################
  624. '#############################################################################
  625. '#############################################################################
  626. '#############################################################################
  627. '#############################################################################
  628. '#############################################################################
  629. '#############################################################################
  630.  
  631.  
  632. Public Function MD5(strMessage As String) As String
  633.     Dim bytBuffer() As Byte
  634.     bytBuffer = MD5StringArray(strMessage)
  635.     MD5Start
  636.     MD564Split Len(strMessage), bytBuffer
  637.     MD5Finish
  638.     MD5 = MD5Value
  639. End Function
  640.  
  641. Public Function SHA1(sMessage As String) As String
  642.     Dim HASH(4)         As Long
  643.     Dim M()             As Long
  644.     Dim W(79)           As Long
  645.     Dim A, B, c, d, e   As Long
  646.     Dim G, h, i, j      As Long
  647.     Dim T1, T2          As Long
  648.     m_lOnBits(0) = 1            ' 00000000000000000000000000000001
  649.     m_lOnBits(1) = 3            ' 00000000000000000000000000000011
  650.     m_lOnBits(2) = 7            ' 00000000000000000000000000000111
  651.     m_lOnBits(3) = 15           ' 00000000000000000000000000001111
  652.     m_lOnBits(4) = 31           ' 00000000000000000000000000011111
  653.     m_lOnBits(5) = 63           ' 00000000000000000000000000111111
  654.     m_lOnBits(6) = 127          ' 00000000000000000000000001111111
  655.     m_lOnBits(7) = 255          ' 00000000000000000000000011111111
  656.     m_lOnBits(8) = 511          ' 00000000000000000000000111111111
  657.     m_lOnBits(9) = 1023         ' 00000000000000000000001111111111
  658.     m_lOnBits(10) = 2047        ' 00000000000000000000011111111111
  659.     m_lOnBits(11) = 4095        ' 00000000000000000000111111111111
  660.     m_lOnBits(12) = 8191        ' 00000000000000000001111111111111
  661.     m_lOnBits(13) = 16383       ' 00000000000000000011111111111111
  662.     m_lOnBits(14) = 32767       ' 00000000000000000111111111111111
  663.     m_lOnBits(15) = 65535       ' 00000000000000001111111111111111
  664.     m_lOnBits(16) = 131071      ' 00000000000000011111111111111111
  665.     m_lOnBits(17) = 262143      ' 00000000000000111111111111111111
  666.     m_lOnBits(18) = 524287      ' 00000000000001111111111111111111
  667.     m_lOnBits(19) = 1048575     ' 00000000000011111111111111111111
  668.     m_lOnBits(20) = 2097151     ' 00000000000111111111111111111111
  669.     m_lOnBits(21) = 4194303     ' 00000000001111111111111111111111
  670.     m_lOnBits(22) = 8388607     ' 00000000011111111111111111111111
  671.     m_lOnBits(23) = 16777215    ' 00000000111111111111111111111111
  672.     m_lOnBits(24) = 33554431    ' 00000001111111111111111111111111
  673.     m_lOnBits(25) = 67108863    ' 00000011111111111111111111111111
  674.     m_lOnBits(26) = 134217727   ' 00000111111111111111111111111111
  675.     m_lOnBits(27) = 268435455   ' 00001111111111111111111111111111
  676.     m_lOnBits(28) = 536870911   ' 00011111111111111111111111111111
  677.     m_lOnBits(29) = 1073741823  ' 00111111111111111111111111111111
  678.     m_lOnBits(30) = 2147483647  ' 01111111111111111111111111111111
  679.     m_l2Power(0) = 1            ' 00000000000000000000000000000001
  680.     m_l2Power(1) = 2            ' 00000000000000000000000000000010
  681.     m_l2Power(2) = 4            ' 00000000000000000000000000000100
  682.     m_l2Power(3) = 8            ' 00000000000000000000000000001000
  683.     m_l2Power(4) = 16           ' 00000000000000000000000000010000
  684.     m_l2Power(5) = 32           ' 00000000000000000000000000100000
  685.     m_l2Power(6) = 64           ' 00000000000000000000000001000000
  686.     m_l2Power(7) = 128          ' 00000000000000000000000010000000
  687.     m_l2Power(8) = 256          ' 00000000000000000000000100000000
  688.     m_l2Power(9) = 512          ' 00000000000000000000001000000000
  689.     m_l2Power(10) = 1024        ' 00000000000000000000010000000000
  690.     m_l2Power(11) = 2048        ' 00000000000000000000100000000000
  691.     m_l2Power(12) = 4096        ' 00000000000000000001000000000000
  692.     m_l2Power(13) = 8192        ' 00000000000000000010000000000000
  693.     m_l2Power(14) = 16384       ' 00000000000000000100000000000000
  694.     m_l2Power(15) = 32768       ' 00000000000000001000000000000000
  695.     m_l2Power(16) = 65536       ' 00000000000000010000000000000000
  696.     m_l2Power(17) = 131072      ' 00000000000000100000000000000000
  697.     m_l2Power(18) = 262144      ' 00000000000001000000000000000000
  698.     m_l2Power(19) = 524288      ' 00000000000010000000000000000000
  699.     m_l2Power(20) = 1048576     ' 00000000000100000000000000000000
  700.     m_l2Power(21) = 2097152     ' 00000000001000000000000000000000
  701.     m_l2Power(22) = 4194304     ' 00000000010000000000000000000000
  702.     m_l2Power(23) = 8388608     ' 00000000100000000000000000000000
  703.     m_l2Power(24) = 16777216    ' 00000001000000000000000000000000
  704.     m_l2Power(25) = 33554432    ' 00000010000000000000000000000000
  705.     m_l2Power(26) = 67108864    ' 00000100000000000000000000000000
  706.     m_l2Power(27) = 134217728   ' 00001000000000000000000000000000
  707.     m_l2Power(28) = 268435456   ' 00010000000000000000000000000000
  708.     m_l2Power(29) = 536870912   ' 00100000000000000000000000000000
  709.     m_l2Power(30) = 1073741824  ' 01000000000000000000000000000000
  710.     ' Initial hash container values
  711.     HASH(0) = &H67452301
  712.     HASH(1) = &HEFCDAB89
  713.     HASH(2) = &H98BADCFE
  714.     HASH(3) = &H10325476
  715.     HASH(4) = &HC3D2E1F0
  716.     
  717.     ' Preprocessing. Append padding bits and length and convert to words.
  718.     M = ConvertToWordArray(sMessage)
  719.     
  720.     ' We process sixteen 32-bit words at a time, which is a 512-bit data block
  721.     For i = 0 To UBound(M) Step 16
  722.         ' Set inital values for the hash operators,
  723.         ' this includes previous hash values.
  724.         A = HASH(0)
  725.         B = HASH(1)
  726.         c = HASH(2)
  727.         d = HASH(3)
  728.         e = HASH(4)
  729.         
  730.         ' We grab the sixteen 32-bit words from our Message word array,
  731.         ' this is the data we'll be working on.
  732.         For G = 0 To 15
  733.             W(G) = M(i + G)
  734.         Next G
  735.         
  736.         ' These sixteen 32-bit words must now be extended through the
  737.         ' initial hashing phase to eighty 32-bit words.
  738.         For G = 16 To 79
  739.             W(G) = LRot(W(G - 3) Xor W(G - 8) Xor W(G - 14) Xor W(G - 16), 1)
  740.         Next G
  741.         
  742.         ' We now begin processing these eighty 32-bit words.
  743.         For j = 0 To 79
  744.             
  745.             ' The processing below is as per SHA1's specification.
  746.             If j <= 19 Then
  747.                 T1 = (B And c) Or ((Not B) And d)
  748.                 T2 = &H5A827999
  749.             ElseIf j <= 39 Then
  750.                 T1 = B Xor c Xor d
  751.                 T2 = &H6ED9EBA1
  752.             ElseIf j <= 59 Then
  753.                 T1 = (B And c) Or (B And d) Or (c And d)
  754.                 T2 = &H8F1BBCDC
  755.             ElseIf j <= 79 Then
  756.                 T1 = B Xor c Xor d
  757.                 T2 = &HCA62C1D6
  758.             End If
  759.             
  760.             ' For each word we process we run the below hashing function and
  761.             ' set it equal to a, shifting the previous a's value down to b,
  762.             ' so a becomes b, b becomes c, after a 30 Left Rotate of 30,
  763.             ' c becomes d, d becomes e.
  764.             h = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(LRot(A, 5), T1), e), T2), W(j))
  765.             e = d
  766.             d = c
  767.             c = LRot(B, 30)
  768.             B = A
  769.             A = h
  770.         Next j
  771.             
  772.         ' We now add the newley hashed values to the hash container.
  773.         HASH(0) = AddUnsigned(A, HASH(0))
  774.         HASH(1) = AddUnsigned(B, HASH(1))
  775.         HASH(2) = AddUnsigned(c, HASH(2))
  776.         HASH(3) = AddUnsigned(d, HASH(3))
  777.         HASH(4) = AddUnsigned(e, HASH(4))
  778.         
  779.     Next i
  780.     
  781.     ' Output the 160-bit digest
  782.     SHA1 = LCase(right("00000000" & Hex(HASH(0)), 8) & _
  783.         right("00000000" & Hex(HASH(1)), 8) & _
  784.         right("00000000" & Hex(HASH(2)), 8) & _
  785.         right("00000000" & Hex(HASH(3)), 8) & _
  786.         right("00000000" & Hex(HASH(4)), 8))
  787. End Function
  788.  
  789.  
  790. Public Function toBase64(sInput As String) As String
  791.     Dim sOutput As String, sLast As String
  792.     Dim B(2) As Byte
  793.     Dim j As Integer
  794.     Dim i As Long, nLen As Long, nQuants As Long
  795.     Dim iIndex As Long
  796.     
  797.     nLen = Len(sInput)
  798.     nQuants = nLen \ 3
  799.     sOutput = String(nQuants * 4, " ")
  800.     iIndex = 0
  801.     ' Now start reading in 3 bytes at a time
  802.     For i = 0 To nQuants - 1
  803.         For j = 0 To 2
  804.            B(j) = Asc(Mid(sInput, (i * 3) + j + 1, 1))
  805.         Next
  806.         Mid$(sOutput, iIndex + 1, 4) = EncodeQuantum(B)
  807.         iIndex = iIndex + 4
  808.     Next
  809.     
  810.     ' Cope with odd bytes
  811.     Select Case nLen Mod 3
  812.     Case 0
  813.         sLast = ""
  814.     Case 1
  815.         B(0) = Asc(Mid(sInput, nLen, 1))
  816.         B(1) = 0
  817.         B(2) = 0
  818.         sLast = EncodeQuantum(B)
  819.         ' Replace last 2 with =
  820.         sLast = left(sLast, 2) & "=="
  821.     Case 2
  822.         B(0) = Asc(Mid(sInput, nLen - 1, 1))
  823.         B(1) = Asc(Mid(sInput, nLen, 1))
  824.         B(2) = 0
  825.         sLast = EncodeQuantum(B)
  826.         ' Replace last with =
  827.         sLast = left(sLast, 3) & "="
  828.     End Select
  829.     
  830.     toBase64 = sOutput & sLast
  831. End Function
  832.  
  833. Public Function fromBase64(sEncoded As String) As String
  834.     Dim sDecoded As String
  835.     Dim d(3) As Byte
  836.     Dim c As Byte
  837.     Dim di As Integer
  838.     Dim i As Long
  839.     Dim nLen As Long
  840.     Dim iIndex As Long
  841.     
  842.     nLen = Len(sEncoded)
  843.     sDecoded = String((nLen \ 4) * 3, " ")
  844.     iIndex = 0
  845.     di = 0
  846.     Call MakeDecTab
  847.     ' Read in each char in trun
  848.     For i = 1 To Len(sEncoded)
  849.         c = CByte(Asc(Mid(sEncoded, i, 1)))
  850.         c = aDecTab(c)
  851.         If c >= 0 Then
  852.             d(di) = c
  853.             di = di + 1
  854.             If di = 4 Then
  855.                 Mid$(sDecoded, iIndex + 1, 3) = DecodeQuantum(d)
  856.                 iIndex = iIndex + 3
  857.                 If d(3) = 64 Then
  858.                     sDecoded = left(sDecoded, Len(sDecoded) - 1)
  859.                     iIndex = iIndex - 1
  860.                 End If
  861.                 If d(2) = 64 Then
  862.                     sDecoded = left(sDecoded, Len(sDecoded) - 1)
  863.                     iIndex = iIndex - 1
  864.                 End If
  865.                 di = 0
  866.             End If
  867.         End If
  868.     Next i
  869.     
  870.     fromBase64 = sDecoded
  871. End Function
  872.